forget chars@Sprite
asm: chars@Sprite ( sprite# -- c1 c2 c3 c4 )
    *sp+ r1 mov,            \ get sprite#
    
    \ look up sprite in sprite attribute list (SAL) in cpu ram 
    r0  blk 298 - li,       \ address of SAL
    r1 2 sla,               \ multiply sprite# by 4
    r1 r0 a,                \ r0 points to entry in SAL
    
    r0 *+ r1 movb,          \ get sprite row
    r1 $0400 ai,            \ offset by 4 pixels
    r1 11 srl,              \ clear high byte, move to low byte and divide by 8

    r0 ** r2 movb,          \ get sprite column
    r2 $0400 ai,            \ offset by 4 pixels
    r2 11 srl,              \ clear high byte, move to low byte and divide by 8
    
    r1 5 sla,               \ multiply row by 32
    r2 r1 a,                \ add column. Screen address now in r1
    
    r0 2 li,                \ repeat twice
    begin,
        r6 2 li,            \ repeat twice
        begin,
            r1 swpb,            \ get screen address low byte
            r1 $8c02 @@ movb,   \ move to vdp address reg
            r1 swpb,            \ get address high byte
            r1 $8c02 @@ movb,   \ move to vdp address reg
            r1 inc,             \ move to next address
            $8800 @@ r7 movb,   \ read the byte from vdp
            r7 8 srl,           \ move to low byte
            sp dect,            \ make space on stack
            r7 *sp mov,         \ push to stack
            r6 dec,             \ finished?
        eq until,               \ repeat if not
        r1 30 ai,               \ move down one screen line
        r0 dec,                 \ finished?
    eq until,                   \ repeat if not
;asm

forget underSprite
asm: underSprite ( char quadrants sprite# -- result )
    \ checks sprite# to see if it is on top of, or partially covering character
    \ char. Use only with 16x16 un-magnified sprites in 32 column mode (gmode=1)
    \ A 16x16 sprite is 2x2 characters, like this:  AB
    \                                               CD
    \ Quadrants is a mask that indicates which quadrants of the sprite should be
    \ checked. The quadrants are specified as follows:
    \   1=A   2=B   4=C   8=D
    \ Since the quadrants are a bitmask, they can be combined. For example, if
    \ you wish to check the entire sprite (all four quadrants) then specify
    \ a value of 15.
    *sp+ r1 mov,            \ get sprite#
    *sp+ r9 mov,            \ get quadrants
    
    \ look up sprite in sprite attribute list (SAL) in cpu ram 
    r0  blk 298 - li,       \ address of SAL
    r1 2 sla,               \ multiply sprite# by 4
    r1 r0 a,                \ r0 points to entry in SAL
    r0 *+ r1 movb,          \ get sprite row
    r1 $0400 ai,            \ offset by 4 pixels
    r1 11 srl,              \ clear high byte, move to low byte and divide by 8
    r0 ** r2 movb,          \ get sprite column
    r2 $0400 ai,            \ offset by 4 pixels
    r2 11 srl,              \ clear high byte, move to low byte and divide by 8
    r1 5 sla,               \ multiply row by 32
    r2 r1 a,                \ add column. Screen address now in r1
    *sp r0 mov,             \ get char from stack
    r0 swpb,                \ move to high byte
    r6 clr,                 \ holds result
    r7 1 li,                \ mask 
    r13 2 li,               \ outer loop counter
    
    begin,
        r1 swpb,            \ get screen address low byte
        r1 $8c02 @@ movb,   \ move to vdp address reg
        r1 swpb,            \ get address high byte
        r1 $8c02 @@ movb,   \ move to vdp address reg
        r14 2 li,           \ inner loop counter & delay for VDP 
        begin,
            $8800 @@ r2 movb,       \ read the byte from vdp
            r9 1 src, lt if,        \ are we interested in this quadrant?
                r0 r2 cb, eq if,    \ compare char from screen with char
                    r7 r6 soc,      \ set mask bit
                endif,
            endif,
            r7 1 sla,               \ shift mask to the left
            r14 dec,            
        eq until,
        r1 32 ai,           \ next screen line
        r13 dec,
    eq until,
    r6 *sp mov,             \ place result on stack 
;asm
base @ HEX CODE: underSprite ( char quadrants sprite# -- result )
C074 C274 0200 A088 0A21 A001 D070 0221 0400 09B1 D090 0222
0400 09B2 0A51 A042 C014 06C0 04C6 0207 0001 020D 0002 06C1
D801 8C02 06C1 D801 8C02 020E 0002 D0A0 8800 0B19 1101 1003
9080 1601 E187 0A17 060E 16F5 0221 0020 060D 16E9 C506 ;CODE base !
: frame ( -- )
    data 8 $ff80 $8080 $8080 $8080 $8080 $8080 $8080 $80ff 256 dchar
    data 8 $ff01 $0101 $0101 $0101 $0101 $0101 $0101 $01ff 258 dchar ;
17 17 value sy value sx
: main ( -- ) 1 gmode  frame  2 magnify   256 0 do i emit loop
    0 sy sx 0 9 sprite  8 23 gotoxy ." Looking for * character"
    begin  0 sy sx sprloc  42 15 0 underSprite  0 23 gotoxy $.
    0 joyst case
    16 of -1 +to sy false endof  8 of 1 +to sy false endof
     2 of -1 +to sx false endof  4 of 1 +to sx false endof
     1 of true endof dup of false endof endcase until ;

main








forget <sprite
: <sprite ( sprite# -- c1 c2 )
    sprloc? 3 + 3 >> swap 3 >> 5 << +  dup v@ swap 32 + v@ ;
    
: sprite> ( sprite# -- c1 c2 )
    sprloc? 13 + 3 >> swap 3 >> 5 << + dup v@ swap 32 + v@ ;
    
: ^sprite ( sprite# -- c1 c2 ) 
    sprloc? 5 + 3 >> swap 1+ 3 >> 5 << +  dup v@ swap 1+ v@ ;
    
: _sprite ( sprite# -- c1 c2 )
    sprloc? 5 + 3 >> swap 13 + 3 >> 5 << +  dup v@ swap 1+ v@ ;